home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / z / Shrub / Window.PAS < prev   
Pascal/Delphi Source File  |  1995-07-29  |  8KB  |  298 lines
  1. (*
  2.  * Shrub... HSPascal source
  3.  *
  4.  * ©Lee Kindness
  5.  *
  6.  * Window.pas
  7.  *
  8.  *)
  9.  
  10. { add window to wb app. list }
  11. Procedure AddAppWin(VAR w : pWindow);
  12.  
  13. Begin
  14.     AppPort := CreateMsgPort;
  15.     if AppPort <> NIL then
  16.         aw := AddAppWindowA(0,0,w,AppPort,NIL);
  17. End;
  18.  
  19. Procedure RemoveAppWin;
  20.  
  21. Var
  22.     Ok : Boolean;
  23.     m  : pMessage;
  24.     
  25. Begin
  26.     if AppPort <> NIL then begin
  27.         m := GetMsg(AppPort);
  28.         While m <> NIL do begin
  29.             ReplyMsg(m);
  30.             m := GetMsg(AppPort);
  31.         End;
  32.     End;
  33.     if aw <> NIL then
  34.         Ok := RemoveAppWindow(aw);
  35.     if AppPort <> NIL then
  36.         DeleteMsgPort(AppPort);
  37. End;
  38.     
  39. (*
  40.  * A little routine to fill in the members of a NewMenu struct
  41.  *
  42.  * Cheat & use a bit of assembler to get direct access to the embedded
  43.  * string constants
  44.  *)
  45. procedure nm(var mnm: tNewMenu;
  46.     nmType: byte;
  47.     nmLabel: string;
  48.     nmCommKey: string;
  49.     nmFlags: word;
  50.     nmMutualExclude: longint;
  51.     nmUserData: LONG); assembler;
  52. asm
  53.     move.l    mnm,a0                        { address of the element }
  54.     move.b    nmType,tNewMenu.nm_Type(a0)    { copy the type }
  55.  
  56.     move.l    nmLabel,a1                    { the address of the Pascal string }
  57.     tst.b    (a1)+                        { check for zero length & skip length byte }
  58.     bne        @1                            { if not zero, nothing to do }
  59.     move.l    #NM_BARLABEL,a1                { substitute empty strings with a bar }
  60. @1:    move.l    a1,tNewMenu.nm_Label(a0)    { store the C string }
  61.  
  62.     move.l    nmCommKey,a1                { same for the CommKey }
  63.     tst.b    (a1)+
  64.     bne        @2
  65.     suba.l    a1,a1                        { use nil if the empty string }
  66. @2:    move.l    a1,tNewMenu.nm_CommKey(a0)
  67.  
  68. { the remaining fields }
  69.     move.w    nmFlags,tNewMenu.nm_Flags(a0)
  70.     move.l    nmMutualExclude,tNewMenu.nm_MutualExclude(a0)
  71.     move.l    nmUserData,tNewMenu.nm_UserData(a0)
  72. end;
  73.  
  74.  
  75.     
  76. { open the main window }
  77. Function OpenTheWindow;
  78.  
  79. Var 
  80.     T              : Array[0..17] Of tTagItem;
  81.     screendef      : pScreen;
  82.     TheWindow      : pWindow;
  83.     mm             : Array[0..22] of tNewMenu;
  84.     Flags, f_si, 
  85.     f_wi, f_fld, 
  86.     f_sodc, f_iodc : LONG;
  87.    
  88. Begin
  89.     TheWindow := NIL;
  90.     
  91.     Flags := CHECKIT|MENUTOGGLE;
  92.     if arg.arg_SaveIcons then
  93.         f_si := Flags|CHECKED
  94.     else
  95.         f_si := Flags;
  96.     if arg.arg_ShowIcons then
  97.         f_wi := Flags|CHECKED
  98.     else
  99.         f_wi := Flags;
  100.     if arg.arg_fld then
  101.         f_fld := Flags|CHECKED
  102.     else
  103.         f_fld := Flags;
  104.     if arg.arg_ShowODC then
  105.         f_sodc := Flags|CHECKED
  106.     else
  107.         f_sodc := Flags;
  108.     if arg.arg_InfoODC then
  109.         f_iodc := Flags|CHECKED
  110.     else
  111.         f_iodc := Flags;
  112.     
  113.     nm(mm[ 0], NM_TITLE, 'Project'#0, '', 0, 0, 0);
  114.     nm(mm[ 1], NM_ITEM , 'Directory...'#0, 'D'#0, 0, 0, M_DIR);
  115.     nm(mm[ 2], NM_ITEM , 'Statistics...'#0, 'U'#0, NM_ITEMDISABLED, 0, M_INFO);
  116.     nm(mm[ 3], NM_ITEM , '', '', 0, 0, 0);
  117.     nm(mm[ 4], NM_ITEM , 'Save As...'#0, 'A'#0, NM_ITEMDISABLED, 0, M_SAVE);
  118.     nm(mm[ 5], NM_ITEM , '', '', 0, 0, 0);
  119.     nm(mm[ 6], NM_ITEM , 'Print'#0, 'P'#0, NM_ITEMDISABLED, 0, M_PRINT);
  120.     nm(mm[ 7], NM_ITEM , 'About...'#0, '?'#0, 0, 0, M_ABOUT);
  121.     nm(mm[ 8], NM_ITEM , '', '', 0, 0, 0);
  122.     nm(mm[ 9], NM_ITEM , 'Quit'#0, 'Q'#0, 0, 0, M_QUIT);
  123.     
  124.     nm(mm[10], NM_TITLE, 'Item'#0, '', 0, 0, 0);
  125.     nm(mm[11], NM_ITEM , 'Show...'#0, 'S'#0, 0, 0, M_SHOWDC);
  126.     If IconBase^.lib_Version >= MININFOVER then
  127.         nm(mm[12], NM_ITEM , 'Info...'#0, 'O'#0, 0, 0, M_INFODC)
  128.     else begin
  129.         nm(mm[12], NM_ITEM , 'Info...'#0, 'O'#0, NM_ITEMDISABLED, 0, M_INFODC);
  130.     End;
  131.     
  132.     nm(mm[13], NM_TITLE, 'Search'#0, '', 0, 0, 0);
  133.     nm(mm[14], NM_ITEM , 'Find...'#0, 'F'#0, NM_ITEMDISABLED, 0, M_FIND);
  134.     nm(mm[15], NM_ITEM , 'Find Next'#0, 'N'#0, NM_ITEMDISABLED, 0, M_FINDNEXT);
  135.     
  136.     nm(mm[16], NM_TITLE, 'Settings'#0, ''#0, 0, 0, 0);
  137.     nm(mm[17], NM_ITEM , 'Create Icons?'#0, 'I'#0, f_si, 0, M_SICO);
  138.     nm(mm[18], NM_ITEM , 'Show Icons?'#0, 'W'#0, f_wi, 0, M_SHOW);
  139.     nm(mm[19], NM_ITEM , 'Follow Linked Drawers'#0, 'F'#0, f_fld, 0, M_FLD);
  140.     nm(mm[20], NM_ITEM , 'Show On Double Click'#0, 'H'#0, f_sodc, 0, M_SODC);
  141.     If IconBase^.lib_Version >= MININFOVER then
  142.         nm(mm[21], NM_ITEM , 'Info On Double Click'#0, 'K'#0, f_iodc, 0, M_IODC)
  143.     else
  144.         nm(mm[21], NM_ITEM , 'Info On Double Click'#0, 'K'#0, f_iodc|NM_ITEMDISABLED, 0, M_IODC);
  145.     nm(mm[22], NM_END , '', '', 0, 0, 0);
  146.     
  147.     G[G_NI]  := NIL;
  148.    
  149.   if arg.arg_Pub <> '' then
  150.         ScreenDef := LockPubScreen(CStrConstPtrAR(@grk, arg.arg_Pub))
  151.     else
  152.         ScreenDef := LockPubScreen(NIL);
  153.     if Screendef = NIL then
  154.         ScreenDef := LockPubScreen(NIL);
  155.  
  156.     { Get visual info and create context }
  157.     vi := GetVisualInfoA(screendef, NIL);
  158.     If vi <> NIL Then begin
  159.         G[G_CC] := CreateContext(@G[G_NI]);
  160.         If G[G_CC] <> NIL Then begin
  161.             { Get some data from the screen }
  162.  
  163.             S[TBS]   := screendef^.WBorTop + (screendef^.Font^.ta_YSize + 1);
  164.             with My_Font, GfxBase^.DefaultFont^, GfxBase^.DefaultFont^.tf_Message.mn_Node do begin
  165.                 ta_Name    := CStrConstPtrAR(@grk, PtrToPas(ln_Name));
  166.                 ta_YSize   := tf_YSize;
  167.                 ta_Style   := tf_Style;
  168.                 ta_Flags   := tf_Flags;
  169.             end;
  170.             { open font (gfxbase.defaultfont can change before window is closed! }
  171.             tf := OpenFont(@My_Font);
  172.             S[S_Gad_H] := 9+screendef^.WBorTop+1;
  173.    
  174.             T[0].ti_Tag  := GTLV_ShowSelected;
  175.             T[0].ti_Data := 0;
  176.             t[1].ti_Tag  := GTLV_Labels;
  177.             t[1].ti_Data := LONG(th^.th_List);
  178.             T[2].ti_Tag := TAG_END;
  179.             
  180.             With GadgetFlags Do Begin
  181.                 ng_TextAttr   := @My_Font;
  182.                 ng_LeftEdge   := 8;
  183.                 ng_TopEdge    := S[TBS]+2;
  184.                 ng_Width      := Arg.arg_Width-ng_LeftEdge*2; 
  185.                 ng_VisualInfo := vi;
  186.                 ng_Height     := Arg.arg_Height-ng_TopEdge-13;
  187.                 if GadToolsBase^.lib_Version < 39 then
  188.                     ng_Height := ng_Height - S[TBS];
  189.                 ng_GadgetText := NIL;
  190.                 ng_GadgetID   := G_LV;
  191.                 ng_Flags      := 0;
  192.             End;
  193.             G[G_LV] := CreateGadgetA(LISTVIEW_KIND, G[G_CC], @Gadgetflags, @T);
  194.                                     
  195.             { window structure }
  196.             T[0].ti_Tag  := WA_Left;
  197.             T[0].ti_Data := arg.arg_Left;
  198.             T[1].ti_Tag  := WA_Top;
  199.             if arg.arg_Top = -1 then
  200.                 T[1].ti_Data := S[TBS]
  201.             else
  202.                 T[1].ti_Data := arg.arg_Top;
  203.             T[2].ti_Tag  := WA_Width;
  204.             T[2].ti_Data := arg.arg_Width;
  205.             T[3].ti_Tag  := WA_Height;
  206.             T[3].ti_Data := arg.arg_Height;
  207.             T[4].ti_Tag  := WA_Title;
  208.             if cdir <> '' then
  209.                 wintitle := 'Tree for "' + cdir + '"'#0
  210.             else
  211.                 wintitle := 'Use Project/Directory... to create tree. ' + DEFTITLE + #0;
  212.             T[4].ti_Data := LONG(@wintitle[1]);
  213.                 
  214.             T[5].ti_Tag  := WA_IDCMP;
  215.             T[5].ti_Data := IDCMP_REFRESHWINDOW|BUTTONIDCMP|LISTVIEWIDCMP|
  216.                             IDCMP_MENUPICK|IDCMP_CLOSEWINDOW|IDCMP_NEWSIZE|
  217.                             IDCMP_CHANGEWINDOW;
  218.             T[6].ti_Tag  := WA_Flags;
  219.             T[6].ti_Data := WFLG_CLOSEGADGET|WFLG_DRAGBAR|WFLG_DEPTHGADGET|
  220.                             WFLG_ACTIVATE|WFLG_SIMPLE_REFRESH|WFLG_NEWLOOKMENUS|
  221.                             WFLG_SIZEGADGET|WFLG_SIZEBBOTTOM;
  222.             T[7].ti_Tag := WA_Gadgets;
  223.             T[7].ti_Data:= LONG(G[G_NI]);
  224.             T[8].ti_Tag := TAG_IGNORE;
  225.             T[8].ti_Data:= 0;
  226.             T[9].ti_Tag  := WA_ScreenTitle;
  227.             
  228.             scrtitle := DEFTITLE + #0; 
  229.             T[9].ti_Data := LONG(@scrtitle[1]);
  230.             
  231.             T[10].ti_Tag := WA_MinWidth;
  232.             T[10].ti_Data:= 130;
  233.             T[11].ti_Tag := WA_MinHeight;
  234.             T[11].ti_Data:= S[TBS]*8;
  235.             T[12].ti_Tag := WA_MaxWidth;
  236.             T[12].ti_Data:= -1;
  237.             T[13].ti_Tag := WA_MaxHeight;
  238.             T[13].ti_Data:= -1;
  239.             T[14].ti_Tag := TAG_IGNORE;
  240.             T[14].ti_Data:= 0;
  241.             if arg.arg_Pub <> '' then begin
  242.                 T[15].ti_Tag  := WA_PubScreenName;
  243.                 T[15].ti_Data := LONG(CStrConstPtrAR(@grk, arg.arg_Pub));
  244.                 T[16].ti_Tag  := WA_PubScreenFallBack;
  245.                 T[16].ti_Data := True_;
  246.                 T[17].ti_Tag := TAG_DONE;
  247.             End else begin
  248.                 T[15].ti_Tag := TAG_DONE;
  249.             End;
  250.   
  251.             TheWindow := OpenWindowTaglist(NIL,@T);
  252.             If TheWindow <> NIL Then begin
  253.                 menustrip := CreateMenusA(@mm, NIL);
  254.                 if menustrip <> NIL then begin
  255.                     T[0].ti_Tag  := GTMN_NewLookMenus;
  256.                     T[0].ti_Data := True_;
  257.                     T[1].ti_Tag  := TAG_END;
  258.                     if LayoutMenusA(menustrip,vi,@T) then
  259.                         OK := SetMenuStrip(TheWindow,MenuStrip);
  260.                 End;
  261.                 GT_RefreshWindow(TheWindow, NIL);
  262.                 proc := pProcess(FindTask(NIL));
  263.                 if proc <> NIL then begin
  264.                     oldwp := proc^.pr_WindowPtr;
  265.                     proc^.pr_WindowPtr := TheWindow;
  266.                 End; 
  267.                 If NOT Empty then
  268.                     EnableMenuItems(TheWindow);
  269.             end;
  270.         end;
  271.     end; 
  272.     UnlockPubScreen(NIL, ScreenDef);
  273.     OpenTheWindow := TheWindow; 
  274. End;
  275.  
  276. Procedure CloseTheWindow;
  277.  
  278. VAR
  279.     m : pMessage;
  280.     
  281. Begin
  282.     if proc <> NIL then begin
  283.         proc^.pr_WindowPtr := oldwp;
  284.     End;
  285.     if MenuStrip <> NIL then begin
  286.         ClearMenuStrip(w);
  287.         FreeMenus(MenuStrip);
  288.     end;
  289.     m := GetMsg(w^.UserPort);
  290.     while m <> NIL do begin
  291.         ReplyMsg(m);
  292.         m := GetMsg(w^.UserPort);
  293.     End;
  294.     CloseWindow(w);
  295.     FreeGadgets(g[G_NI]);
  296.     FreeVisualInfo(vi);
  297.     CloseFont(tf);
  298. End;